home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue44 / singletn / singlebase.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-01-26  |  1.2 KB  |  70 lines
  1. unit singlebase;
  2.  
  3. interface
  4.  
  5. type
  6.   TSingleton = class (TObject)
  7.   public
  8.     class function NewInstance: TObject; override;
  9.     procedure FreeInstance; override;
  10.     // debug
  11.     class function ListClasses: string;
  12.     class procedure FreeAll;
  13.   end;
  14.  
  15. implementation
  16.  
  17. uses
  18.   classes;
  19.  
  20. var
  21.   InstanceList: TStringList;
  22.   Destroying: Boolean = False;
  23.  
  24. class procedure TSingleton.FreeAll;
  25. var
  26.   I: Integer;
  27. begin
  28.   Destroying := True;
  29.   for I := 0 to InstanceList.Count - 1 do
  30.     InstanceList.Objects [I].Free;
  31. end;
  32.  
  33. procedure TSingleton.FreeInstance;
  34. begin
  35.   if Destroying then
  36.     inherited FreeInstance;
  37. end;
  38.  
  39. class function TSingleton.ListClasses: string;
  40. var
  41.   I: Integer;
  42. begin
  43.   Result := '';
  44.   for I := 0 to InstanceList.Count - 1 do
  45.     Result := Result + InstanceList [I] + ';';
  46. end;
  47.  
  48. class function TSingleton.NewInstance: TObject;
  49. var
  50.   idx: Integer;
  51. begin
  52.   idx := InstanceList.IndexOf (ClassName);
  53.   if idx >= 0 then
  54.     Result := InstanceList.Objects [idx]
  55.   else
  56.   begin
  57.     Result := inherited NewInstance;
  58.     InstanceList.AddObject (ClassName, Result);
  59.   end;
  60. end;
  61.  
  62. initialization
  63.   InstanceList := TStringList.Create;
  64.  
  65. finalization
  66.   TSingleton.FreeAll;
  67.   InstanceList.Free;
  68.  
  69. end.
  70.